home *** CD-ROM | disk | FTP | other *** search
/ Turnbull China Bikeride / Turnbull China Bikeride - Disc 2.iso / STUTTGART / FROMUTS / PERL / Perl / Lib / Complete < prev    next >
Text File  |  1991-02-09  |  2KB  |  107 lines
  1. ;#
  2. ;#    @(#)complete.pl    1.0 (sun!waynet) 11/11/88
  3. ;#
  4. ;# Author: Wayne Thompson
  5. ;#
  6. ;# Description:
  7. ;#     This routine provides word completion.
  8. ;#     (TAB) attempts word completion.
  9. ;#     (^D)  prints completion list.
  10. ;#    (These may be changed by setting $Complete'complete, etc.)
  11. ;#
  12. ;# Diagnostics:
  13. ;#     Bell when word completion fails.
  14. ;#
  15. ;# Bugs:
  16. ;#
  17. ;# Usage:
  18. ;#     $input = do Complete('prompt_string', @completion_list);
  19. ;#
  20.  
  21. CONFIG: {
  22.     package Complete;
  23.  
  24.     $complete =    "\004";
  25.     $kill =    "\025";
  26.     $erase1 =    "\177";
  27.     $erase2 =    "\010";
  28. }
  29.  
  30. sub Complete {
  31.     package Complete;
  32.  
  33.     local ($prompt) = shift (@_);
  34.     local ($c, $cmp, $l, $r, $ret, $return, $test);
  35.     @_cmp_lst = sort @_;
  36.     local($[) = 0;
  37.     loop: {
  38.     print $prompt, $return;
  39.     while (($c = &kernel_getc()) ne "\r") {
  40.         if ($c eq "\t") {            # (TAB) attempt completion
  41.         @_match = ();
  42.         foreach $cmp (@_cmp_lst) {
  43.             push (@_match, $cmp) if $cmp =~ /^$return/;
  44.         }
  45.                 $test = $_match[0];
  46.                 $l = length ($test);
  47.         unless ($#_match == 0) {
  48.                     shift (@_match);
  49.                     foreach $cmp (@_match) {
  50.                         until (substr ($cmp, 0, $l) eq substr ($test, 0, $l)) {
  51.                             $l--;
  52.                         }
  53.                     }
  54.                     &kernel_bell;
  55.                 }
  56.                 print $test = substr ($test, $r, $l - $r);
  57.                 $r = length ($return .= $test);
  58.         }
  59.         elsif ($c eq $complete) {        # (^D) completion list
  60.         print "\r\n";
  61.         foreach $cmp (@_cmp_lst) {
  62.             print "$cmp\r\n" if $cmp =~ /^$return/;
  63.         }
  64.         redo loop;
  65.         }
  66.             elsif ($c eq $kill && $r) {    # (^U) kill
  67.                 $return = '';
  68.                 $r = 0;
  69.                 print "\r\n";
  70.                 redo loop;
  71.             }
  72.                                             # (DEL) || (BS) erase
  73.         elsif ($c eq $erase1 || $c eq $erase2) {
  74.         if($r) {
  75.             print "\b \b";
  76.             chop ($return);
  77.             $r--;
  78.         }
  79.         }
  80.         elsif ($c =~ /\S/) {                # printable char
  81.         $return .= $c;
  82.         $r++;
  83.         print $c;
  84.         }
  85.     }
  86.     }
  87.     print "\n";
  88.     $return;
  89. }
  90.  
  91. sub kernel_bell {
  92.     syscall(256+7);
  93. }
  94.  
  95. sub kernel_getc {
  96.     local ($ch, $regs);
  97.     if ($regs = syscall("OS_ReadC")) {
  98.     ($ch) = unpack("C",$regs);
  99.     pack("c",$ch);
  100.     }
  101.     else {
  102.     undef;
  103.     }
  104. }
  105.  
  106. 1;
  107.